home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form Form1
- BackColor = &H00FFFFFF&
- Caption = "This is Splinal App!"
- ClientHeight = 6630
- ClientLeft = 2745
- ClientTop = 1800
- ClientWidth = 5970
- Height = 7035
- Icon = SPLINAPP.FRX:0000
- Left = 2685
- LinkMode = 1 'Source
- LinkTopic = "Form1"
- ScaleHeight = 6630
- ScaleWidth = 5970
- Top = 1455
- Width = 6090
- Begin CommandButton btnAbout
- Caption = "&About..."
- Height = 435
- Left = 4410
- TabIndex = 27
- Top = 6090
- Width = 1275
- End
- Begin CommandButton btnExit
- Caption = "E&xit"
- Height = 435
- Left = 2940
- TabIndex = 24
- Top = 5535
- Width = 1275
- End
- Begin CommandButton btnReset
- Caption = "&Reset"
- Height = 435
- Left = 4410
- TabIndex = 9
- Top = 5535
- Width = 1275
- End
- Begin Frame ParameterFrame
- BackColor = &H00FFFFFF&
- Caption = "Parameters"
- Height = 2025
- Left = 2910
- TabIndex = 17
- Top = 3255
- Width = 2775
- Begin SpinButton spinBias
- Delay = 50
- Enabled = 0 'False
- Height = 285
- Left = 2415
- Top = 1440
- Width = 225
- End
- Begin SpinButton spinTension
- Delay = 50
- Enabled = 0 'False
- Height = 285
- Left = 2415
- Top = 1080
- Width = 225
- End
- Begin SpinButton spinResolution
- Delay = 50
- Height = 285
- Left = 2415
- Top = 720
- Width = 225
- End
- Begin TextBox txtBias
- Enabled = 0 'False
- Height = 285
- Left = 1680
- TabIndex = 8
- Top = 1440
- Width = 750
- End
- Begin TextBox txtTension
- Enabled = 0 'False
- Height = 285
- Left = 1680
- TabIndex = 7
- Top = 1080
- Width = 750
- End
- Begin TextBox txtResolution
- Height = 285
- Left = 1680
- TabIndex = 6
- Top = 720
- Width = 750
- End
- Begin Label lblNumPointsLabel
- Alignment = 1 'Right Justify
- BackColor = &H00FFFFFF&
- Caption = "Number of Points:"
- Height = 285
- Left = 15
- TabIndex = 23
- Top = 360
- Width = 1575
- End
- Begin Label lblResolution
- Alignment = 1 'Right Justify
- BackColor = &H00FFFFFF&
- Caption = "Resolution:"
- Height = 240
- Left = 15
- TabIndex = 22
- Top = 720
- Width = 1605
- End
- Begin Label lblTension
- Alignment = 1 'Right Justify
- BackColor = &H00FFFFFF&
- Caption = "Tension:"
- Enabled = 0 'False
- Height = 270
- Left = 15
- TabIndex = 21
- Top = 1080
- Width = 1575
- End
- Begin Label lblBias
- Alignment = 1 'Right Justify
- BackColor = &H00FFFFFF&
- Caption = "Bias:"
- Enabled = 0 'False
- Height = 270
- Left = 15
- TabIndex = 20
- Top = 1440
- Width = 1575
- End
- Begin Label lblNumPoints
- Caption = "###"
- Height = 285
- Left = 1680
- TabIndex = 19
- Top = 360
- Width = 960
- End
- End
- Begin Frame TypeFrame
- BackColor = &H00FFFFFF&
- Caption = "Curve Type"
- Height = 2685
- Left = 315
- TabIndex = 11
- Top = 3255
- Width = 2535
- Begin PictureBox picCurveColor
- Height = 255
- Index = 6
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 18
- Top = 710
- Width = 375
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "Control &Points"
- Height = 255
- Index = 6
- Left = 120
- TabIndex = 4
- Top = 710
- Value = 1 'Checked
- Width = 1575
- End
- Begin PictureBox picCurveColor
- Height = 255
- Index = 5
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 16
- Top = 2160
- Width = 375
- End
- Begin CommonDialog CMDialog1
- Left = 1890
- Top = 2415
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "&Tau"
- Height = 255
- Index = 5
- Left = 120
- TabIndex = 5
- Top = 2160
- Width = 1095
- End
- Begin PictureBox picCurveColor
- Height = 255
- Index = 4
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 15
- Top = 1800
- Width = 375
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "B&eta"
- Height = 255
- Index = 4
- Left = 120
- TabIndex = 3
- Top = 1800
- Width = 1215
- End
- Begin PictureBox picCurveColor
- Height = 255
- Index = 3
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 14
- Top = 1440
- Width = 375
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "&Bspline"
- Height = 255
- Index = 3
- Left = 120
- TabIndex = 2
- Top = 1440
- Width = 1215
- End
- Begin PictureBox picCurveColor
- Height = 255
- Index = 2
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 13
- Top = 1080
- Width = 375
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "Be&zier"
- Height = 255
- Index = 2
- Left = 120
- TabIndex = 1
- Top = 1080
- Width = 1110
- End
- Begin PictureBox picCurveColor
- Height = 255
- Index = 0
- Left = 1950
- ScaleHeight = 225
- ScaleWidth = 345
- TabIndex = 12
- Top = 360
- Width = 375
- End
- Begin CheckBox chkCurveType
- BackColor = &H00FFFFFF&
- Caption = "&Control Polygon"
- Height = 255
- Index = 0
- Left = 120
- TabIndex = 0
- Top = 360
- Value = 1 'Checked
- Width = 1725
- End
- End
- Begin PictureBox picDisplay
- AutoRedraw = -1 'True
- Height = 2955
- Left = 315
- ScaleHeight = 195
- ScaleMode = 3 'Pixel
- ScaleWidth = 357
- TabIndex = 10
- TabStop = 0 'False
- Top = 210
- Width = 5385
- Begin Label lblOdom
- Alignment = 2 'Center
- BorderStyle = 1 'Fixed Single
- Height = 225
- Left = 4320
- TabIndex = 25
- Top = 2625
- Width = 960
- End
- End
- Begin Label Label1
- Caption = "Click left button to add new point. Click right button to delete last point."
- Height = 435
- Left = 210
- TabIndex = 26
- Top = 6165
- Width = 3270
- End
- 'Copyright (C) Andrew S. Dean 1993-95
- Option Explicit
- Const idxControlPolygon = 0
- Const idxHermite = 1
- Const idxBezier = 2
- Const idxBspline = 3
- Const idxBeta = 4
- Const idxTau = 5
- Const idxControlPoints = 6
- Const EM_AddPoint = 0
- Const EM_MovePoint = 1
- Const EM_DeletePoint = 2
- ' Use this to determine whether left or right
- ' mouse button was clicked in display.
- Dim giButton As Integer
- Sub AddControlPoint (fx As Single, fy As Single, fz As Single)
- glNumControlPoints = glNumControlPoints + 1
- ' Add the new point to the control polygon.
- ControlPoly(glNumControlPoints).fx = fx
- ControlPoly(glNumControlPoints).fy = fy
- ControlPoly(glNumControlPoints).fz = fz
- ' Update the text value.
- lblNumPoints.Caption = Str$(glNumControlPoints)
- End Sub
- Sub btnAbout_Click ()
- frmAbout.Show MODAL
- End Sub
- Sub btnExit_Click ()
- End
- End Sub
- Sub btnReset_Click ()
- glNumControlPoints = 0
- lblNumPoints.Caption = Str$(glNumControlPoints)
- picDisplay.Cls
- End Sub
- Sub chkCurveType_Click (Index As Integer)
- picDisplay.Cls
- DrawAllActiveCurves
- If (chkCurveType(idxBeta).Value = CHECKED) Then
- txtTension.Enabled = True
- txtBias.Enabled = True
- lblTension.Enabled = True
- lblBias.Enabled = True
- spinTension.Enabled = True
- spinBias.Enabled = True
- ElseIf (chkCurveType(idxTau).Value = CHECKED) Then
- txtTension.Enabled = True
- txtBias.Enabled = True
- lblTension.Enabled = True
- lblBias.Enabled = True
- spinTension.Enabled = True
- spinBias.Enabled = True
- ElseIf (chkCurveType(idxBspline).Value = CHECKED) Then
- txtTension.Enabled = True
- txtBias.Enabled = False
- lblTension.Enabled = True
- lblBias.Enabled = False
- spinTension.Enabled = True
- spinBias.Enabled = False
- Else
- txtTension.Enabled = False
- txtBias.Enabled = False
- lblTension.Enabled = False
- lblBias.Enabled = False
- spinTension.Enabled = False
- spinBias.Enabled = False
- End If
- End Sub
- Sub DeleteLastPoint ()
- If (glNumControlPoints = 0) Then
- Exit Sub
- End If
- glNumControlPoints = glNumControlPoints - 1
- ' Update the text value.
- lblNumPoints.Caption = Str$(glNumControlPoints)
- End Sub
- Sub Delta (C As TextBox, dDelta As Double)
- Dim dVal As Double
- dVal = Val(C.Text)
- dVal = dVal + dDelta
- C.Text = Format(dVal)
- End Sub
- Sub DrawAllActiveCurves ()
- If (glNumControlPoints <= 0) Then
- Exit Sub
- End If
- If chkCurveType(idxControlPolygon).Value = CHECKED Then
- DrawControl
- End If
- If chkCurveType(idxBspline).Value = CHECKED Then
- DrawBspline
- End If
- If chkCurveType(idxBezier).Value = CHECKED Then
- DrawBezier
- End If
- If chkCurveType(idxBeta).Value = CHECKED Then
- DrawBeta
- End If
- If chkCurveType(idxTau).Value = CHECKED Then
- DrawTau
- End If
- If chkCurveType(idxControlPoints).Value = CHECKED Then
- DrawControlPoints
- End If
- End Sub
- Sub DrawBeta ()
- Dim I As Long
- Dim lCurveLen As Long
- ' Call DLL function to compute spline points.
- lCurveLen = BetaSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0))
- 'Label4 = lCurveLen
- ' Draw the spline.
- picDisplay.CurrentX = Curve(0).fx
- picDisplay.CurrentY = Curve(0).fy
- For I = 1 To lCurveLen
- picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBeta).BackColor
- Next I
- End Sub
- Sub DrawBezier ()
- Dim I As Long
- Dim lCurveLen As Long
- ' Call DLL function to compute spline points.
- lCurveLen = Bezier(glCurveResolution, glNumControlPoints, ControlPoly(0), Curve(0))
- 'Label3 = lCurveLen
- ' Draw the spline.
- picDisplay.CurrentX = Curve(0).fx
- picDisplay.CurrentY = Curve(0).fy
- For I = 1 To lCurveLen
- picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBezier).BackColor
- Next I
- End Sub
- Sub DrawBspline ()
- Dim I As Long
- Dim lCurveLen As Long
- ' Call DLL function to compute spline points.
- lCurveLen = Bspline(glCurveResolution, gfTension, glNumControlPoints, ControlPoly(0), Curve(0))
- 'Label2 = lCurveLen
- ' Draw the spline.
- picDisplay.CurrentX = Curve(0).fx
- picDisplay.CurrentY = Curve(0).fy
- For I = 1 To lCurveLen
- picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBspline).BackColor
- Next I
- End Sub
- Sub DrawControl ()
- Dim I As Long
- picDisplay.CurrentX = ControlPoly(1).fx
- picDisplay.CurrentY = ControlPoly(1).fy
- For I = 2 To glNumControlPoints
- picDisplay.Line -(ControlPoly(I).fx, ControlPoly(I).fy), picCurveColor(idxControlPolygon).BackColor
- Next I
- End Sub
- Sub DrawControlPoints ()
- Dim I As Long
- ' Display all the current control points.
- ' Note: Would it be better to use a shape control?
- ' What would be easier for moving/dragging? I
- ' don't think it matters much for deleting.
- For I = 1 To glNumControlPoints
- picDisplay.Circle (ControlPoly(I).fx, ControlPoly(I).fy), 3, picCurveColor(idxControlPoints).BackColor
- Next I
- End Sub
- Sub DrawTau ()
- Dim I As Long
- Dim lCurveLen As Long
- ' Call DLL function to compute spline points.
- lCurveLen = TauSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0))
- 'Label5 = lCurveLen
- ' Draw the spline.
- picDisplay.CurrentX = Curve(0).fx
- picDisplay.CurrentY = Curve(0).fy
- For I = 1 To lCurveLen
- picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxTau).BackColor
- Next I
- End Sub
- Sub Form_Load ()
- CenterForm Form1
- ' Initial line colors.
- picCurveColor(idxControlPolygon).BackColor = RGB(255, 0, 0)
- picCurveColor(idxBezier).BackColor = RGB(0, 255, 0)
- picCurveColor(idxBspline).BackColor = RGB(0, 0, 255)
- picCurveColor(idxTau).BackColor = RGB(0, 255, 255)
- picCurveColor(idxBeta).BackColor = RGB(255, 0, 255)
- picCurveColor(idxControlPoints).BackColor = RGB(0, 0, 0)
- ' Initial parameter values.
- glNumControlPoints = 0
- lblNumPoints.Caption = Str$(glNumControlPoints)
- glCurveResolution = 10
- txtResolution.Text = Str$(glCurveResolution)
- gfTension = 1#
- txtTension.Text = Str$(gfTension)
- gfBias = 1#
- txtBias.Text = Str$(gfBias)
- End Sub
- Sub picCurveColor_Click (Index As Integer)
- CMDialog1.Color = &HFF&
- CMDialog1.Flags = CC_RGBINIT
- ' Display color dialog
- CMDialog1.Action = 3
- ' Set the pic color
- picCurveColor(Index).BackColor = CMDialog1.Color
- picDisplay.Cls
- DrawAllActiveCurves
- End Sub
- Sub picDisplay_Click ()
- If (giButton = LEFT_BUTTON) Then
- AddControlPoint CSng(picDisplay.CurrentX), CSng(picDisplay.CurrentY), 0#
- picDisplay.Cls
- Else
- DeleteLastPoint
- picDisplay.Cls
- End If
- DrawAllActiveCurves
- End Sub
- Sub picDisplay_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
- ' Update the Current coordinates whenever the mouse
- ' is down. Current* can then be used in the click.
- picDisplay.CurrentX = X
- picDisplay.CurrentY = Y
- ' If the right mouse button went down, set up to delete the last control
- ' point. This is a Q&D undo function.
- giButton = Button
- End Sub
- Sub picDisplay_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim szOdom As String
- szOdom = "(" & X & "," & Y & ")"
- lblOdom.Caption = szOdom
- End Sub
- Sub picDisplay_Paint ()
- DrawAllActiveCurves
- End Sub
- Sub spinBias_SpinDown ()
- Delta txtBias, -.1
- End Sub
- Sub spinBias_SpinUp ()
- Delta txtBias, .1
- End Sub
- Sub spinResolution_SpinDown ()
- Delta txtResolution, -1
- End Sub
- Sub spinResolution_SpinUp ()
- Delta txtResolution, 1
- End Sub
- Sub spinTension_SpinDown ()
- Delta txtTension, -.1
- End Sub
- Sub spinTension_SpinUp ()
- Delta txtTension, .1
- End Sub
- Sub txtBias_Change ()
- gfBias = Val(txtBias.Text)
- picDisplay.Cls
- DrawAllActiveCurves
- End Sub
- Sub txtResolution_Change ()
- glCurveResolution = Val(txtResolution.Text)
- If (glCurveResolution <= 0) Then
- MsgBox "Resolution must be a positive number."
- Exit Sub
- End If
- picDisplay.Cls
- DrawAllActiveCurves
- End Sub
- Sub txtTension_Change ()
- gfTension = Val(txtTension.Text)
- picDisplay.Cls
- DrawAllActiveCurves
- End Sub
-